home *** CD-ROM | disk | FTP | other *** search
/ The Best of Select: Games Special 4 / THE BEST OF SELECT Games Special 4 (Select CD-ROM)(1996).iso / dosgames / abuse / addon / pong / pong.lsp next >
Lisp/Scheme  |  1995-09-13  |  12KB  |  333 lines
  1. ;;;; Copyright 1995 Crack dot Com,  All Rights reserved
  2. ;;;; See licensing information for more details on usage rights
  3.  
  4. ;;;; to play this game, go to the abuse root directory and type :
  5. ;;;; abuse -lsf addon/pong/pong.lsp
  6. ;;;; -lsf tells abuse to use an alternate Lisp Startup File than abuse.lsp
  7.  
  8. ;;;; Notes :
  9. ;;;;   This "game" was written by Jonathan Clark as a demonstration of the
  10. ;;;; capabilities of the abuse engine.  It is not meant to be a complete game
  11. ;;;; and is released strictly for purpose of study only.  Any part of this file
  12. ;;;; may be used by others and distributed in any form, but it uses some of the
  13. ;;;; lisp, sound effects, and artwork from Abuse (TM) which may only distributed
  14. ;;;; as a complete package with no files missing or changed.
  15.  
  16. ;;;; ***** Emacs plug *********
  17. ;;;; If you don't already have emacs, get it!  It's free.
  18. ;;;; Firstly it makes editing lisp 100% easier because it matches braces.
  19. ;;;; Secondly if you load the hi-lighting .el file you can read this file much
  20. ;;;; easier because all comments, strings, etc will be different colors.
  21. ;;;; I don't know the exact site where to find it, but if you telnet to
  22. ;;;; archie.unl.edu or look it up on a web search server you are sure to find it.
  23. ;;;; You might be interest to know emacs is also very customizable using a language
  24. ;;;; called lisp :-)
  25.  
  26. ;;;; Please do not ask me for docs on how to code with the abuse engine, there are 
  27. ;;;; none at this time and there won't be any until networked abuse is available.
  28. ;;;; ALL games written with the abuse engine are network ready with no additional
  29. ;;;; work including this one, but there are some issues that need addressing 
  30. ;;;; that cannot be fully discussed until the net code is finished.  When these
  31. ;;;; docs are written they will be available at http://www.crack.com   Estimated
  32. ;;;; date for these docs is sometime late Oct. 1995
  33.  
  34. (perm-space)   ; define all functions and global variable in "perm space" which
  35.                ; is a space which will be garbage collected when it fills up.
  36.                ; The down side to garbage collection is that it is a little slow
  37.                ; and users of very slow machines will notice a very small pause
  38.                ; from time to time, though writers of games may ignore this issue and
  39.                ; always stay in "perm space"
  40.                ;
  41.                ; "tmp space" on the other hand, is not garbage collected, but rather
  42.                ; at the end of executing an object's function will be completely
  43.                ; thrown away it's important not to do a setq on a global variable
  44.                ; (not local and not a member of the object) because the memory the
  45.                ; item resides in will be lost after the function finishes.. see the
  46.                ; add_score function in this file.
  47.  
  48.  
  49. ;; this is a simple check to see if they player has an engine version
  50. ;; capable of playing the game.  All games should at least check for version 1.0
  51. ;; because all version before that are beta and have known bugs.
  52. (if (< (+ (* (major_version) 100) (minor_version)) 100)    ; require at least version 1.0
  53.     (progn
  54.       (print "Your engine is out of date.  This game requires verion 1.0")
  55.       (quit)))
  56.  
  57.  
  58. (setq pong_dir "addon/pong/")  ; in case we change the location of these files later
  59.                                ; this is always a very good idea to do because the user of
  60.                                ; this program may/may not be able to install into this directory       
  61. (setq pong_art (concatenate 'string pong_dir "pong.spe"))  ; all artwork is in this file
  62.  
  63. (setq load_warn nil)            ; don't show a waringing if these files aren't there
  64. (load "lisp/english.lsp")       ; need this for various translated messages (english only pong for now!)
  65. (load "gamma.lsp")              ; gamma correction values (if saved)
  66. (setq load_warn T)
  67.  
  68. (load "lisp/common.lsp")        ; grab the definition of abuse's light holder & obj mover
  69. (load "lisp/userfuns.lsp")      ; load seq defun
  70. (load "lisp/input.lsp")         ; get input mapping stuff from abuse
  71.  
  72.  
  73. ;; these are a few things that the engine requires you to load...
  74. (load_big_font     "art/letters.spe" "letters")
  75. (load_small_font   "art/letters.spe" "small_font")
  76. (load_console_font "art/consfnt.spe" "fnt5x7")
  77. (load_color_filter "art/back/backgrnd.spe")
  78. (load_palette      "art/back/backgrnd.spe")
  79. (load_tiles pong_art)  ; load all foreground & background type images from pong.spe
  80.  
  81. ;; this is the image that will be displayed when the game starts
  82. ;; this needs to be in the form (X . Y) where X is the filename and
  83. ;; Y is the name of the image
  84. (setq title_screen      (cons pong_art "title_screen"))
  85.  
  86. ;; define a few sound effects to be used (these are all from abuse)
  87. (def_sound 'METAL  "sfx/lasrmis2.wav")
  88. (def_sound 'BHIT   "sfx/delobj01.wav")
  89. (def_sound 'BLOWUP "sfx/ball01.wav")
  90. (def_sound 'BUTTON_PRESS_SND "sfx/button02.wav")  ; used by menu system
  91.  
  92. ;; use these images to draw the score
  93. (setq nums (make-array 10 :initial-contents (list (def_image pong_art "0")
  94.                           (def_image pong_art "1")
  95.                           (def_image pong_art "2")
  96.                           (def_image pong_art "3")
  97.                           (def_image pong_art "4")
  98.                           (def_image pong_art "5")
  99.                           (def_image pong_art "6")
  100.                           (def_image pong_art "7")
  101.                           (def_image pong_art "8")
  102.                           (def_image pong_art "9"))))
  103. (setq score 0)
  104.  
  105. (defun show_score (x y digs_left score)
  106.   (if (not (eq digs_left 0))       ; end recursion
  107.       (let ((this-digit (/ score digs_left)))
  108.     (put_image x y (aref nums this-digit))
  109.     (show_score (+ x (image_width (aref nums this-digit))) y 
  110.             (/ digs_left 10) (- score (* digs_left this-digit))))))
  111.  
  112. (defun paddle_draw ()
  113.   (draw)                          ; normal draw function
  114.   (show_score (- (view_x2) 80) (view_y1) 1000000 score))
  115.  
  116. (defun add_score (amount)
  117.   (perm-space)     ; we are modifing a global var, so we need swith to perm space
  118.   (setq score (+ score amount))
  119.   (tmp-space))     ; switch back to tmp space which is not garbage collected
  120.  
  121.  
  122. (defun destroyable_tile (x) (> x 1))
  123.  
  124. (defun blow_up_tile (tilex tiley)
  125.   (let ((gamex (+ (* tilex 16) 8))
  126.     (gamey   (+ (* tiley 7) 7)))
  127.     (add_score 200)
  128.     (add_object EXPLOSION gamex gamey)
  129.     (destroy_tile tilex tiley)))
  130.  
  131. (defun destroy_tile (tilex tiley)
  132.   (let ((gamex (+ (* tilex 16) 8))
  133.     (gamey   (+ (* tiley 7) 7))
  134.     (type (fg_tile tilex tiley)))
  135.     (add_score 100)
  136.     (set_fg_tile tilex tiley 0)            ; clear the tile and start animation
  137.     (if (eq type 6)                        ; dinamite tile?
  138.     (progn
  139.       (blow_up_tile tilex tiley)
  140.       (if (and (> tilex 0))
  141.           (blow_up_tile (- tilex 1) tiley))
  142.       (if (and (> tiley 0))
  143.           (blow_up_tile tilex (- tiley 1)))
  144.       (blow_up_tile tilex (+ tiley 1))
  145.       (blow_up_tile (+ tilex 1) tiley)))
  146.           
  147.     (with_object (bg) (add_hp 10))           ; give player points
  148.  
  149.     (add_object TILE_BLOW_UP gamex gamey)
  150.     (if (eq (random 10) 0)
  151.     (add_object PILL1 gamex gamey)
  152.       (if (eq (random 30) 0)
  153.       (add_object PILL2 gamex gamey)))))
  154.  
  155.  
  156. (defun check_collide (status)    ;; returns T if we hit something
  157.   (if (not (eq status T))                                  ; did we hit anything?
  158.       (if (eq (car (cdr status)) 'object)                  ; did we hit an object?          
  159.       (let ((object (car (cdr (cdr status)))))
  160.         (if (eq (with_object object (otype)) PADDLE)   ; did we hit the paddle?
  161.         (if (<= (aistate) 180)
  162.             (progn
  163.               (set_aistate (+ (aistate) (- (with_object object (x)) (x))))
  164.               (if (> 20 (aistate)) (set_aistate 20)
  165.             (if (< 160 (aistate)) (set_aistate 160)))
  166.               T) 
  167.           nil)
  168.           nil)
  169.         nil)
  170.     (if (eq (car (cdr status)) 'tile)                   ; did we hit a tile?
  171.         (let ((tilex (car (cdr (cdr status))))
  172.           (tiley (car (cdr (cdr (cdr status))))))
  173.           (let ((type (fg_tile tilex tiley)))
  174.           (if (destroyable_tile type)                   ; can we destroy the tile?
  175.           (progn
  176.             (destroy_tile tilex tiley)
  177.             (if (eq type 6)
  178.             (play_sound BLOWUP 100)
  179.               (play_sound BHIT)))
  180.         (play_sound METAL 60)))
  181.           T)
  182.       nil))
  183.     nil))
  184.  
  185.  
  186. (defun move_ball ()  ;; returns status of move
  187.   (let ((status (float_tick)))
  188.     (if (not